home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / e / amigae30a_fr.lha / AmigaE30f / Sources / Pd / gtlv.e < prev    next >
Encoding:
Text File  |  1994-12-02  |  8.1 KB  |  234 lines
  1. /*------------------------------------------------------------------------------------------*
  2.   Source E génératé par SRCGEN v0.1
  3.  
  4.   Démo montrant la création, le gestion , le nettoyage d'un listview de la gadtools.library.
  5.   Inclu des gadgets bouton et chaine pour la fonctionnalité.
  6.   AUTEUR:  B. Wills + SRCGEN :-)
  7.  *------------------------------------------------------------------------------------------*/
  8. OPT OSVERSION=37
  9.  
  10. MODULE 'gadtools', 'libraries/gadtools', 'intuition/intuition',
  11.        'intuition/screens', 'graphics/text',
  12.        'exec/lists', 'exec/nodes', 'utility/tagitem'
  13.  
  14. /*-- Function return values. --*/
  15. ENUM NONE, NOCONTEXT, NOGADGET, NOWB, NOVISUAL, OPENGT, NOWINDOW, NOMENUS, MEM
  16.  
  17. /*-- Gadget IDs. --*/
  18. ENUM ADDBUTTON_ID, DELETEBUTTON_ID, STRING_ID, LISTVIEW_ID
  19.  
  20. RAISE "MEM" IF New()=NIL,
  21.       "MEM" IF String()=NIL
  22.  
  23. /*-- Variables Standards de SrcGen. --*/
  24. DEF win=NIL:PTR TO window,
  25.     scr=NIL:PTR TO screen,
  26.     glist=NIL,
  27.     visual=NIL,
  28.     infos:PTR TO gadget,
  29.     messageClass,
  30.     offx, offy, tattr
  31.  
  32. /*-- Listview et gadgets associés. --*/
  33. DEF list=NIL:PTR TO mlh,            /* liste Exec prend les entrées listview    */
  34.     listView=NIL:PTR TO gadget,     /* gadget listview                          */
  35.     addButton=NIL:PTR TO gadget,    /* gadget bouton pour ajouter une entrée    */
  36.     deleteButton=NIL:PTR TO gadget, /* gadget bouton pour effacer une entrée    */
  37.     stringGadget=NIL:PTR TO gadget, /* gadget chaine, valeur ajoutée au listiew */
  38.     stringGadgetValue:PTR TO CHAR   /* Pointeur sur le le gadget de chaine      */
  39.  
  40. PROC initList(l:PTR TO mlh)
  41. /*-- Initialise une liste exec. --*/
  42.   l.head:=l+4
  43.   l.tail:=NIL
  44.   l.tailpred:=l
  45. ENDPROC
  46.  
  47. PROC setupScreen()
  48. /*-- Ouvre bibliothèques et prend les infos écran. --*/
  49.   IF (gadtoolsbase:=OpenLibrary('gadtools.library',37))=NIL THEN RETURN OPENGT
  50.   IF (scr:=LockPubScreen('Workbench'))=NIL THEN RETURN NOWB
  51.   IF (visual:=GetVisualInfoA(scr,NIL))=NIL THEN RETURN NOVISUAL
  52.   offy:=scr.wbortop+Int(scr.rastport+58)-10
  53.   tattr:=['topaz.font',8,0,0]:textattr
  54. ENDPROC  NONE
  55.  
  56. PROC closeScreen()
  57. /*-- Libère resources, ferme écran et bibliothèques. --*/
  58.   IF glist THEN FreeGadgets(glist)
  59.   IF visual THEN FreeVisualInfo(visual)
  60.   IF scr THEN UnlockPubScreen(NIL,scr)
  61.   IF gadtoolsbase THEN CloseLibrary(gadtoolsbase)
  62. ENDPROC
  63.  
  64. PROC createGadgets()
  65. /*-- Initialise structures gadget et les créés. --*/
  66.   DEF g, stringInfo:PTR TO stringinfo
  67.   /*-- Init list Exec pour prendre les entrées listview. Commence à vide. --*/
  68.   list:=New(SIZEOF mlh)
  69.   initList(list)
  70.   IF (g:=CreateContext({glist}))=NIL THEN RETURN NOCONTEXT
  71.   IF (g:=listView:=CreateGadgetA(LISTVIEW_KIND, g,
  72.     [offx+7, offy+13, 243, 100,
  73.      'Ma liste', tattr, LISTVIEW_ID, 0, visual, 0]:newgadget,
  74.     [GTLV_LABELS,       list,
  75.      GTLV_SHOWSELECTED, NIL, TAG_DONE]))=NIL THEN RETURN NOGADGET
  76.   IF (g:=stringGadget:=CreateGadgetA(STRING_KIND,g,
  77.     [offx+7, offy+111, 243, 12,
  78.      '', tattr, STRING_ID, 0, visual, 0]:newgadget,
  79.     [GTST_MAXCHARS,25, TAG_DONE]))=NIL THEN RETURN NOGADGET
  80. /*-- C'est là que le tempo gadget est caché ! --*/
  81.   stringInfo:=stringGadget.specialinfo
  82.   stringGadgetValue:=stringInfo.buffer
  83. /*-------------------------------------------------------*/
  84.   IF (g:=addButton:=CreateGadgetA(BUTTON_KIND, g,
  85.     [offx+58, offy+111+15, 65, 17,
  86.      'Ajouter', tattr, ADDBUTTON_ID, 16, visual, 0]:newgadget,
  87.     [TAG_DONE]))=NIL THEN RETURN NOGADGET
  88.   IF (g:=deleteButton:=CreateGadgetA(BUTTON_KIND, g,
  89.     [offx+129, offy+111+15, 65, 17,
  90.      'Effacer', tattr, DELETEBUTTON_ID, 16, visual, 0]:newgadget,
  91.     [TAG_DONE]))=NIL THEN RETURN NOGADGET
  92. ENDPROC  NONE
  93.  
  94. PROC openWindow()
  95.   IF createGadgets()<>NONE THEN RETURN NOGADGET
  96.   /*-- Note WA_IDCMP pour prendre des messages du gadget listview: --*/
  97.   IF (win:=OpenWindowTagList(NIL,
  98.     [WA_LEFT,         38,
  99.      WA_TOP,          14,
  100.      WA_WIDTH,        offx+257,
  101.      WA_HEIGHT,       offy+150,
  102.      WA_IDCMP,        (IDCMP_REFRESHWINDOW OR IDCMP_CLOSEWINDOW OR IDCMP_GADGETUP OR
  103.                        IDCMP_MOUSEMOVE OR LISTVIEWIDCMP OR SCROLLERIDCMP),
  104.      WA_FLAGS,        (WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_CLOSEGADGET OR
  105.                        WFLG_SMART_REFRESH OR WFLG_ACTIVATE),
  106.      WA_TITLE,NIL,
  107.      WA_CUSTOMSCREEN, scr,
  108.      WA_MINWIDTH,     67,
  109.      WA_MINHEIGHT,    21,
  110.      WA_MAXWIDTH,     $2C0,
  111.      WA_MAXHEIGHT,    277,
  112.      WA_AUTOADJUST,   1,
  113.      WA_GADGETS,      glist,
  114.      TAG_DONE]))=NIL THEN RETURN NOWINDOW
  115.   Gt_RefreshWindow(win, NIL)
  116. ENDPROC NONE
  117.  
  118. PROC closeWindow()
  119.   IF win THEN CloseWindow(win)
  120. ENDPROC
  121.  
  122. PROC wait4message(win:PTR TO window)
  123.   DEF mes:PTR TO intuimessage, type
  124.   REPEAT
  125.     type:=0
  126.     IF mes:=Gt_GetIMsg(win.userport)
  127.       type:=mes.class
  128.       SELECT type
  129.         CASE IDCMP_GADGETUP
  130.           /*-- Tout les vieux gadget vont le faire. L'adresse est faite --*/
  131.           /*-- pour identifier qui à envoyé le message.                 --*/
  132.           infos:=mes.iaddress
  133.           infos.gadgetid:=mes.code
  134.         CASE IDCMP_REFRESHWINDOW
  135.           Gt_BeginRefresh(win)
  136.           Gt_EndRefresh(win,TRUE)
  137.           type:=0
  138.       ENDSELECT
  139.       Gt_ReplyIMsg(mes)
  140.     ELSE
  141.       WaitPort(win.userport)
  142.     ENDIF
  143.   UNTIL type
  144. ENDPROC type
  145.  
  146. PROC addToList()
  147.   DEF newNode=NIL:PTR TO ln, node:PTR TO ln,
  148.       len, done=FALSE, itemPosition=0
  149.   /*-- N'ajoute pas si il n'y a rien dans le gadget de chaine. --*/
  150.   IF (len:=StrLen(stringGadgetValue))=0 THEN RETURN
  151.   /*-- Crée un noeud et une chaine pour ajouter au listview. --*/
  152.   newNode:=New(SIZEOF ln)
  153.   newNode.name:=String(len)
  154.   StrCopy(newNode.name, stringGadgetValue, ALL)
  155.   /*-- Détache la list Exec du gadget listview. --*/
  156.   Gt_SetGadgetAttrsA (listView, win, NIL, [GTLV_LABELS, -1, TAG_DONE])
  157.   /*-- Décide où insérer la nouvelle entrée. Tri sur le premier caractère. --*/
  158.   node:=list.head
  159.   IF list.tailpred=list
  160.     AddHead(list, newNode)
  161.   ELSEIF Char(node.name)>stringGadgetValue[]
  162.     AddHead(list, newNode)
  163.   ELSEIF node=list.tailpred
  164.     AddTail(list, newNode)
  165.   ELSE
  166.     WHILE done=FALSE
  167.       node:=node.succ
  168.       INC itemPosition
  169.       IF Char(node.name)>stringGadgetValue[]
  170.         done:=TRUE
  171.       ELSEIF node.succ=NIL
  172.         done:=TRUE
  173.       ENDIF
  174.     ENDWHILE
  175.     Insert(list, newNode, node.pred)
  176.   ENDIF
  177.   /*-- Reattach the exec list to the listview gadget. --*/
  178.   Gt_SetGadgetAttrsA (listView, win, NIL,
  179.                       [GTLV_LABELS, list,
  180.                        GTLV_TOP,    itemPosition,
  181.                        TAG_DONE])
  182. ENDPROC
  183.  
  184. PROC deleteFromList(itemPosition)
  185.   DEF node:PTR TO ln, i
  186.   /*-- N'efface pas si aucune entrée n'est sélectionnée. --*/
  187.   IF (itemPosition=-1) OR (list.tailpred=list) THEN RETURN
  188.   /*-- Détache la liste Exec du gadget listview. --*/
  189.   Gt_SetGadgetAttrsA (listView, win, NIL, [GTLV_LABELS, -1, TAG_DONE])
  190.   /*-- Cherche le noeud qui correspond à itemPosition dans la liste Exec. --*/
  191.   node:=list.head
  192.   FOR i:=1 TO itemPosition DO node:=node.succ
  193.   /*-- Enlève et désalloue les données du noeuds. --*/
  194.   Remove(node)
  195.   Dispose(node.name)
  196.   Dispose(node)
  197.   /*-- Reattache la liste exec au gadget listview. --*/
  198.   Gt_SetGadgetAttrsA (listView, win, NIL,
  199.                       [GTLV_LABELS, list, TAG_DONE])
  200. ENDPROC
  201.  
  202. PROC main() HANDLE
  203.   DEF listItemPosition=-1 /* valeur sentinelle, indique aucune sélection */
  204.   IF setupScreen()=NONE
  205.     IF openWindow()=NONE
  206.       REPEAT
  207.         messageClass:=wait4message(win)
  208.         SELECT messageClass
  209.           CASE IDCMP_GADGETUP
  210.             SELECT infos  /* pointeur sur gadget */
  211.               CASE addButton
  212.                 addToList()  /* demande une valeur dans le gadget chaine */
  213.               CASE deleteButton
  214.                 deleteFromList(listItemPosition) /* demande une sélection */
  215.                 listItemPosition:=-1             /* valeur sentinelle=pas de sélection */
  216.               CASE listView
  217.                 listItemPosition:=infos.gadgetid /* notez l'utilistion de ce champ ! */
  218.             ENDSELECT
  219.           CASE IDCMP_INTUITICKS
  220.             NOP /* Ceci est envoyé pour quelques raisons (que la raison ignore) }:-( */
  221.         ENDSELECT
  222.       UNTIL messageClass=IDCMP_CLOSEWINDOW
  223.       closeWindow()
  224.     ENDIF
  225.   ENDIF
  226.   closeScreen()
  227.   CleanUp(0)
  228. EXCEPT
  229.   WriteF('Exception: "\s"\n', [exception, 0])
  230.   closeWindow()
  231.   closeScreen()
  232.   CleanUp(0)
  233. ENDPROC
  234.